This forum is closed to new posts and
responses. Individual names altered for privacy purposes. The information contained in this website is provided for informational purposes only and should not be construed as a forum for customer support requests. Any customer support requests should be directed to the official HCL customer support channels below:
Dim m_Width As Long
Dim m_Height As Long
Dim m_Depth As Variant
Dim m_imagetype As Integer
Dim ImageType As String
Dim iFN As Integer
Dim lPos As Long
Dim MybBuf As Variant
Dim myByte As Variant
Dim bBuf() As Variant
Function GetImageProperties(ImageFileName As String)
filename = ImageFileName
' Set all properties to default values
m_Width = 0
m_Height = 0
m_Depth = 0
m_ImageType = itUNKNOWN
' Read the first 32k of the image file into a buffer
' NB - this is a LotusScript limitation and 32K may not be enough
' to read a JPEG's image data but it probably will.
Redim bBuf(BUFFERSIZE)
lpos = 0
iFN = Freefile
Open FileName For Binary As iFN
idx = 0
Do While Not Eof( iFN ) And idx < BUFFERSIZE
bBuf(idx) = Asc(Inputb( 1 , ifn ))
idx = idx + 1
Loop
Close iFn
If bBuf(0) = 127 And bBuf(1) = 80 And bBuf(2) = 78 Then
m_ImageType = itPNG ' this is a PNG file
ImageType = "PNG"
Select Case bBuf(25) ' get bit depth
Case 0
m_Depth = bBuf(24) ' greyscale
Case 2
m_Depth = bBuf(24) * 3 ' RGB encoded
Case 3
m_Depth = 8 ' Palette based, 8 bpp
Case 4
m_Depth = bBuf(24) * 2 ' greyscale with alpha
Case 6
m_Depth = bBuf(24) * 4 ' RGB encoded with alpha
' This value is outside of it's normal range, so we'll assume that this is not a valid file
Case Else
m_ImageType = itUNKNOWN
End Select
If m_ImageType Then ' if the image is valid then
m_Width = Mult(bBuf(19), bBuf(18)) ' get the width
m_Height = Mult(bBuf(23), bBuf(22)) ' get the height
End If
End If
If bBuf(0) = 71 And bBuf(1) = 73 And bBuf(2) = 70 Then ' this is a GIF file
m_ImageType = itGIF
ImageType = "GIF"
m_Width = Mult(bBuf(6), bBuf(7)) ' get the width
m_Height = Mult(bBuf(8), bBuf(9)) ' get the height
m_Depth = (bBuf(10) And 7) + 1 ' get bit depth
End If
If bBuf(0) = 66 And bBuf(1) = 77 Then ' this is a BMP file
m_ImageType = itBMP
ImageType = "BMP"
m_Width = Mult(bBuf(18), bBuf(19)) ' get the width
m_Height = Mult(bBuf(22), bBuf(23)) ' get the height
m_Depth = bBuf(28) ' get bit depth
End If
If m_ImageType = itUNKNOWN Then ' if the file is not one of the above type then check to see if it is a JPEG file
Do
' loop through looking for the byte sequence FF,D8,FF which marks the begining of a JPEG file
' lPos will be left at the postion of the start
If (bBuf(lPos) = &HFF And bBuf(lPos + 1) = &HD8 And bBuf(lPos + 2) = &HFF) _
Or (lPos >= BUFFERSIZE - 10) Then Exit Do
' move our pointer up
lPos = lPos + 1
Loop
lPos = lPos + 2
If lPos >= BUFFERSIZE - 10 Then Exit Function
Do
' loop through the markers until we find the one starting with FF,C0 which is the block containing the
' image information
Do
' loop until we find the beginning of the next marker
If bBuf(lPos) = &HFF And bBuf(lPos + 1) _
<> &HFF Then Exit Do
lPos = lPos + 1
If (lPos >= BUFFERSIZE - 10) Then Exit Function
Loop
' move pointer up
lPos = lPos + 1
Select Case bBuf(lPos)
Case &HC0 To &HC3, &HC5 To &HC7, &HC9 To &HCB, &HCD To &HCF
' we found the right block
Exit Do
End Select
lPos = lPos + Mult(bBuf(lPos + 2), bBuf(lPos + 1)) ' otherwise keep looking
If lPos >= BUFFERSIZE - 10 Then Exit Function 'check for end of buffer
Loop
' If we've gotten this far it is a JPEG and we are ready to grab the information.
m_ImageType = itJPEG
ImageType = "JPEG"
m_Height = Mult(bBuf(lPos + 5), bBuf(lPos + 4)) ' get the height
m_Width = Mult(bBuf(lPos + 7), bBuf(lPos + 6)) ' get the width
m_Depth = bBuf(lPos + 8) * 8 ' get the color depth
End If
Use this
Return to top
. . Use this (~Ned Mintoolita... 22.Jan.11) 
